home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / public / GNU / emacs.inst / emacs19.idb / usr / gnu / lib / emacs / site-lisp / gnus-mark.el.z / gnus-mark.el
Encoding:
Text File  |  1994-08-02  |  21.9 KB  |  577 lines
  1. ;;; -*- Mode:Emacs-Lisp -*-
  2.  
  3. ;;; gnus-mark.el v1.6
  4. ;;; Operating on more than one news article at a time.
  5. ;;; Created:  28-Jun-91 by Jamie Zawinski <jwz@lucid.com>
  6. ;;; Modified: 28-Jun-91 by Sebastian Kremer <sk@thp.Uni-Koeln.DE>
  7. ;;; Modified: 01-Dec-91 by Jamie Zawinski <jwz@lucid.com>
  8. ;;; Modified: 05-Dec-91 by Paul D. Smith <paul_smith@dg.com>
  9. ;;; Modified: 28-Nov-92 by A1C Tim Miller <tjm@hrt213.brooks.af.mil>
  10. ;;; Modified: 10-Jun-93 by Vivek Khera <khera@cs.duke.edu> (GNUS 3.15 fixes)
  11. ;;; Modified: 15-Sep-93 by Jamie Zawinski <jwz@lucid.com> (article saving)
  12. ;;;
  13. ;;; typing `@' in the subject buffer will mark the current article with
  14. ;;; an `@'.  After marking more than one article this way, you can use one
  15. ;;; of the commands in this file on all of them at once.
  16. ;;;
  17. ;;; `M-@' will prompt you for a regular expression, and will mark all f
  18. ;;; articles which match.
  19. ;;;
  20. ;;; `^U@' will prompt you for a mark-character to use other than `@'.
  21. ;;;
  22. ;;; To unmark an article, use `u', `d', or `^U M-@ SPC RET'.
  23. ;;;
  24. ;;; `F' (gnus-forward-marked-articles) will put you in a send-mail buffer 
  25. ;;; along with the contents of all of the marked articles in RFC-944 digest
  26. ;;; format, suitable for later explosion with any reasonable mail reader.
  27. ;;;
  28. ;;; `M-x gnus-uudecode-marked-messages' (M-x gnus-uu RET works) will strip the
  29. ;;; junk from the beginning and end of the marked articles, concatenate them
  30. ;;; together, and pipe the result through uudecode.  If the resultant file is
  31. ;;; a tar file and/or is compressed, this command offers to unpack/uncompress
  32. ;;; as well.  See also the variables gnus-uudecode-file-mode, 
  33. ;;; gnus-uudecode-auto-chmod, and gnus-uudecode-auto-touch.  If the first
  34. ;;; marked message is not the first part of the uuencoded file, or if the last
  35. ;;; marked message is not the last part of the uuencoded file, it complains.
  36. ;;; However, it's not possible to tell if the middle parts are out of order,
  37. ;;; so make sure you use ^C^S^S to get the articles in the right order first.
  38. ;;; It also complains about obviously-corrupted files.
  39. ;;;
  40. ;;; `M-x gnus-unshar-marked-articles' (M-x gnus-un RET works) will strip the 
  41. ;;; junk from the beginning and end of the marked articles, and run each of
  42. ;;; them through sh in turn.  This doesn't work on shar files that don't 
  43. ;;; begin with "#!".
  44. ;;;
  45. ;;; Both of the above commands prompt you for a directory in which to do the
  46. ;;; dirty work.  If the directory you specify doesn't exist, you have the
  47. ;;; option of creating it.
  48. ;;;
  49. ;;; `C-o' and `o' (`gnus-summary-save-in-mail' and `gnus-summary-save-article')
  50. ;;; will operate on the marked articles, assuming you are using one of the 
  51. ;;; standard functions for `gnus-default-article-saver', those being
  52. ;;; `gnus-summary-save-in-rmail', `gnus-summary-save-in-mail',
  53. ;;; `gnus-summary-save-in-folder', and `gnus-summary-save-in-file'.  If you 
  54. ;;; use a different function here, it should be pretty obvious from reading
  55. ;;; the code how to convert it to operate on the marked articles.
  56. ;;;
  57. ;;; When saving articles, the variable `gnus-save-marked-in-same-file' controls
  58. ;;; whether to prompt for the file/folder intowhich each article should be 
  59. ;;; written.  If t, you will be asked where to save them once, and all 
  60. ;;; messages will be saved to the same place.  If nil, you will be prompted
  61. ;;; for each article.
  62. ;;
  63. ;; LCD Archive Entry:
  64. ;; gnus-mark|Jamie Zawinski|jwz@lucid.com
  65. ;; |Operate on more than one news article at a time
  66. ;; |93-09-15|1.6|~/misc/gnus-mark.el.Z|
  67.  
  68. (require 'gnus)
  69.  
  70. (define-key gnus-summary-mode-map "@" 'gnus-summary-mark-article)
  71. (define-key gnus-summary-mode-map "\C-F" 'gnus-forward-marked-articles)
  72. (define-key gnus-summary-mode-map "\M-@" 'gnus-summary-mark-regexp)
  73. ;;; See also gnus-uudecode-marked-messages and gnus-unshar-marked-articles.
  74.  
  75. (defvar gnus-default-mark-char ?@
  76.   "*Character used to mark articles for later commands in GNUS.")
  77.  
  78. (defun gnus-summary-mark-article (mark)
  79. "Mark the current article for later commands.
  80. This marker comes from variable `gnus-default-mark-char'.
  81. You can change this variable by giving a prefix argument to this command,
  82. in which case you will be prompted for the character to use."
  83.   (interactive (list (if current-prefix-arg
  84.              (let ((cursor-in-echo-area t))
  85.                (message "Mark message with: ")
  86.                (setq gnus-default-mark-char (read-char)))
  87.              gnus-default-mark-char)))
  88.   (or (eq (current-buffer) (get-buffer gnus-summary-buffer))
  89.       (error "not in summary buffer"))
  90.   (gnus-summary-mark-as-read nil gnus-default-mark-char)
  91.   (gnus-summary-next-subject 1 nil))
  92.  
  93. ;; Actually, gnus-kill should have an interactive spec!
  94. (defun gnus-summary-mark-regexp (regexp &optional marker)
  95.   "Mark all articles with subjects matching REGEXP.
  96. With a prefix ARG, prompt for the marker.  Type RET immediately to
  97. mark them as unread or enter SPC RET to remove all kinds of marks."
  98.   (interactive
  99.    (list (read-string "Mark (regexp): ")
  100.      (if current-prefix-arg
  101.          (read-string
  102.           "Mark with char (RET to mark as unread, SPC RET to remove existing markers): "))))
  103.   (setq marker (or marker (char-to-string gnus-default-mark-char)))
  104.   (gnus-kill "Subject" regexp
  105.          (if (equal "" marker)
  106.          '(gnus-summary-mark-as-unread)
  107.            (list 'gnus-summary-mark-as-read nil marker))
  108.          ;; overwrite existing marks:
  109.          t))
  110.  
  111. (defun gnus-summary-mark-map-articles (mark function)
  112.   (save-excursion
  113.     (set-buffer gnus-summary-buffer)
  114.     (let ((str (concat "^" (make-string 1 mark) " +\\([0-9]+\\):"))
  115.       got-one)
  116.       (save-excursion
  117.     (goto-char (point-min))
  118.     (while (not (eobp))
  119.       (if (looking-at str)
  120.           (progn
  121.         (setq got-one t)
  122.         (save-excursion
  123.           (funcall function
  124.             (gnus-find-header-by-number gnus-newsgroup-headers 
  125.               (string-to-int
  126.             (buffer-substring
  127.               (match-beginning 1) (match-end 1))))))))
  128.       (forward-line 1)))
  129.       (cond ((not got-one)
  130.          (let ((article (gnus-summary-article-number)))
  131.            (if (or (null gnus-current-article)
  132.                (/= article gnus-current-article))
  133.            ;; Selected subject is different from current article's.
  134.            (gnus-summary-display-article article))
  135.            (funcall function 
  136.             (gnus-find-header-by-number gnus-newsgroup-headers 
  137.                             article)))))
  138.       )))
  139.  
  140.  
  141. ;;; simpler, more specific to gnus-mark version of shell-command
  142.  
  143. (defun gnus-mark-shell-command (start end command erase)
  144.   "Execute string COMMAND in inferior shell with region as input.
  145. Display output (if any) in temp buffer interactively.
  146. If ERASE is non-nil the buffer is erased, otherwise the output is
  147. appended to the end of the buffer."
  148.     (let ((buffer (get-buffer-create "*Shell Command Output*"))
  149.       (orig-buffer (current-buffer)))
  150.       (set-buffer buffer)
  151.       (if erase
  152.       (erase-buffer)
  153.     (goto-char (point-max)))
  154.       (set-buffer orig-buffer)
  155.       (if (eq buffer orig-buffer)
  156.       (setq start 1 end 1))
  157.       (display-buffer buffer)
  158.       (bury-buffer buffer)
  159.       (call-process-region start end shell-file-name
  160.                nil buffer t "-c" command)))
  161.  
  162.  
  163. ;;; RFC944 forwarding of multiple messages
  164.  
  165. (defun gnus-forward-marked-articles ()
  166.   "Forward the marked messages to another user, RFC944 style."
  167.   (interactive)
  168.   (let (subj p
  169.     (state 'first)
  170.     tmp-buf)
  171.     (unwind-protect
  172.     (progn
  173.       (setq tmp-buf (get-buffer-create "*gnus-forward-tmp*"))
  174.       (save-excursion (set-buffer tmp-buf) (erase-buffer))
  175.       (gnus-summary-mark-map-articles
  176.        gnus-default-mark-char
  177.        (function (lambda (msg)
  178.          (if (eq state 'first) (setq state t) (setq state nil))
  179.          (message "Snarfing article %s..." (aref msg 0))
  180.          (if (eq gnus-current-article (aref msg 0))
  181.          (gnus-summary-mark-as-read)
  182.            (gnus-summary-display-article (aref msg 0)))
  183.          (set-buffer gnus-article-buffer)
  184.          (widen)
  185.          (set-buffer tmp-buf)
  186.          (goto-char (point-max))
  187.          (if subj
  188.          (insert "----------\n")
  189.            (setq subj (aref msg 1)))
  190.          (setq p (point))
  191.          (insert-buffer gnus-article-buffer)
  192.          (goto-char p)
  193.          (while (re-search-forward "^-" nil t)
  194.            (insert " -"))
  195.          )))
  196.       (mail nil nil (concat "[Fwd: " subj "]"))
  197.       (save-excursion
  198.         (goto-char (point-max))
  199.         (insert (if state
  200.             "---------- Begin forwarded message\n"
  201.               "---------- Begin digest\n"))
  202.         (insert-buffer tmp-buf)
  203.         (goto-char (point-max))
  204.         (insert (if state
  205.             "\n---------- End forwarded message\n"
  206.               "\n---------- End digest\n"))))
  207.       ;; protected
  208.       (and tmp-buf (kill-buffer tmp-buf)))))
  209.  
  210.  
  211. ;;; reading a directory name, and offering to create if it doesn't exist.
  212.  
  213. (defun gnus-mark-read-directory (prompt &optional default-dir)
  214.   (let ((dir
  215.      (read-file-name prompt
  216.              (or default-dir default-directory)
  217.              (or default-dir default-directory))))
  218.     (if (string-match "/$" dir)
  219.     (setq dir (substring dir 0 (match-beginning 0))))
  220.     (setq dir
  221.       (cond ((file-directory-p dir) dir)
  222.         ((file-exists-p dir)
  223.          (ding)
  224.          (message "%s exists and is not a directory!" dir)
  225.          (sleep-for 2)
  226.          (gnus-mark-read-directory prompt dir))
  227.         ((y-or-n-p (format "directory %s doesn't exist, create it? " dir))
  228.          (make-directory dir)
  229.          dir)
  230.         (t (gnus-mark-read-directory prompt dir))))
  231.     (if (string-match "/$" dir)
  232.     dir
  233.       (concat dir "/"))))
  234.  
  235.  
  236. ;;; uudecode
  237.  
  238. (defconst gnus-uudecode-begin-pattern
  239.     "^begin[ \t]+\\([0-9][0-9][0-9][0-9]?\\)[ \t]+\\([^ \t\n]*\\)$")
  240.  
  241. (defconst gnus-uudecode-body-pattern
  242.     "^M.............................................................?$")
  243.  
  244. (defconst gnus-uudecode-begin-or-body-pattern
  245.     (concat "\\(" gnus-uudecode-begin-pattern "\\|"
  246.         gnus-uudecode-body-pattern "\\)"))
  247.  
  248. (defvar gnus-uudecode-file-mode "644"
  249.   "*If non-nil, this overrides the mode specified in the `begin' line of
  250. a uuencoded file being unpacked by vm-uudecode.  This should be a string,
  251. which is the mode desired in octal.")
  252.  
  253. (defvar gnus-uudecode-auto-chmod "u+w"
  254.   "*If non-nil, then when gnus is untarring a file for you, it will
  255. apply this chmod modifier to each of the unpacked files.  This should be
  256. a string like \"u+w\".")
  257.  
  258. (defvar gnus-uudecode-auto-touch t
  259.   "*If non-nil, then when vm-uudecode is untarring a file for you, it will
  260. cause the write-date of each of the unpacked files to be the current time.
  261. Normally tar unpacks files with the time at which they are packed; this can
  262. cause your `make' commands to fail if you are installing a new version of
  263. a package which you have modified.")
  264.  
  265. (defvar gnus-uudecode-picture-pattern "\\.\\(gif\\|p[bgp]m\\|rast\\|pic\\|jpg\\|tiff?\\)$"
  266.   "*If non-nil, this should be a pattern which matches files which are 
  267. images.  When gnus-uudecode-marked-articles creates a file which matches
  268. this pattern, it will ask you if you want to look at it now.  If so, it
  269. invokes gnus-uudecode-picture-viewer with the filename as an argument.
  270. After doing this, it asks you if you want to keep the picture or delete it.")
  271.  
  272. (defvar gnus-uudecode-picture-viewer "xv"
  273.   "*The picture viewer that gnus-uudecode-marked-messages uses.  See doc of
  274. variable gnus-uudecode-picture-pattern.")
  275.  
  276. (defvar gnus-uudecode-default-directory nil "*")
  277.  
  278. (defun gnus-uudecode-marked-articles (directory)
  279.   "Strip the junk from the beginning and end of the marked articles, 
  280. concatenate them together, and pipe the result through uudecode.  If
  281. the resultant file is a tar file and/or is compressed, this command
  282. offers to unpack/uncompress as well.  See also the variables
  283. gnus-uudecode-file-mode, gnus-uudecode-auto-chmod, and
  284.  gnus-uudecode-auto-touch."
  285.   (interactive (list (gnus-mark-read-directory "uudecode in directory: "
  286.                gnus-uudecode-default-directory)))
  287.   (setq gnus-uudecode-default-directory directory)
  288.   (let ((state 'first)
  289.     tmp-buf
  290.     name)
  291.     (unwind-protect
  292.       (progn
  293.        (setq tmp-buf  (get-buffer-create "*gnus-uudecode-tmp*"))
  294.        (save-excursion (set-buffer tmp-buf) (erase-buffer))
  295.        (gnus-summary-mark-map-articles
  296.     gnus-default-mark-char
  297.     (function (lambda (msg)
  298.       (message "Snarfing article %s..." (aref msg 0))
  299.       (if (eq state 'last)
  300.           (error "articles out of order: articles follow `end' line."))
  301.       (if (eq gnus-current-article (aref msg 0))
  302.           (gnus-summary-mark-as-read)
  303.         (gnus-summary-display-article (aref msg 0)))
  304.       (set-buffer gnus-article-buffer)
  305.       (widen)
  306.       (set-buffer tmp-buf)
  307.       (goto-char (point-max))
  308.       (let ((p (point))
  309.         (case-fold-search nil))
  310.         (insert-buffer gnus-article-buffer)
  311.         (cond
  312.          ((eq state 'first)
  313.           (or (re-search-forward gnus-uudecode-begin-pattern nil t)
  314.           (error "couldn't find `begin' line in first article."))
  315.           ;; I'd like to second-guess the losers who use mixed-case
  316.           ;; and upper-case filenames, but this trashes trailing ".Z"
  317.           ;;(downcase-region (match-beginning 2) (match-end 2))
  318.           (setq name (buffer-substring (match-beginning 2) (match-end 2)))
  319.           ;; don't tolerate bogus umasks.
  320.           (if gnus-uudecode-file-mode
  321.           (progn
  322.             (goto-char (match-beginning 1))
  323.             (delete-region (match-beginning 1) (match-end 1))
  324.             (insert gnus-uudecode-file-mode)))
  325.           (setq state 'middle))
  326.          (t
  327.           (or (re-search-forward gnus-uudecode-begin-or-body-pattern nil t)
  328.           (error "couldn't find beginning of data."))))
  329.         (beginning-of-line)
  330.         (delete-region p (point))
  331.         (let (c len tmp)
  332.           ;; This could be sped up a lot, but then we'd lose the
  333.           ;; error checking it does; maybe that's ok.
  334.           (while (progn
  335.                (forward-line)
  336.                (setq c (- (following-char) ? ))
  337.                (end-of-line)
  338.                (setq tmp (/ (1- (current-column)) 4))
  339.                (beginning-of-line)
  340.                (= (+ tmp (+ tmp tmp)) c))
  341.         )
  342.           ;; Slack.
  343.           (setq p (point))
  344.           (if (or (looking-at "end\n")
  345.               (progn (forward-line 1) (looking-at "end\n"))
  346.               (progn (forward-line 1) (looking-at "end\n"))
  347.               (progn (forward-line 1) (looking-at "end\n")))
  348.           (progn
  349.             (forward-line 1)
  350.             (setq state 'last))
  351.         (goto-char p))
  352.           )
  353.         (delete-region (point) (point-max))))))
  354.        (or (eq state 'last) (error "no `end' line in last article."))
  355.        (set-buffer tmp-buf)
  356.        (let* ((base-file (file-name-nondirectory name))
  357.           (final-file (concat directory base-file))
  358.           (command (concat "cd " directory " ; uudecode"))
  359.           tar-p)
  360.      (cond ((string-match "\\.tar\\.Z$" base-file)
  361.         (if (y-or-n-p "uncompress/untar? ")
  362.             (setq command (concat command " && zcat "
  363.                       base-file " | tar -vxf -")
  364.               final-file nil
  365.               tar-p t)))
  366.            ((string-match "\\.tar$" base-file)
  367.         (if (y-or-n-p "untar? ")
  368.             (setq command (concat command " && tar -vxf " base-file)
  369.               final-file nil
  370.               tar-p t)))
  371.            ((string-match "\\.Z$" base-file)
  372.         (if (y-or-n-p "uncompress? ")
  373.             (setq command (concat command " ; uncompress " base-file)
  374.               final-file (substring base-file 0
  375.                         (match-beginning 0))))))
  376.      (let ((str (concat "executing \"" command "\" ...")))
  377.        (message str)
  378.        (gnus-mark-shell-command (point-min) (point-max) command t)
  379. ;       (if final-file
  380. ;          (dired-add-entry-all-buffers directory
  381. ;         (file-name-nondirectory final-file)))
  382.        (message (concat str " done.")))
  383.      (cond
  384.       (tar-p
  385.        (set-buffer (get-buffer "*Shell Command Output*"))
  386.        (let ((all (concat command "\n" (buffer-string)))
  387.          files files-str)
  388.          (goto-char (point-min))
  389.          (while (not (eobp))
  390.            (if (looking-at "^x \\([^,\n]+\\), ")
  391.            (setq files (cons (buffer-substring
  392.                       (match-beginning 1) (match-end 1))
  393.                      files)))
  394.            (forward-line 1))
  395.          (setq files (nreverse files)
  396.            files-str (mapconcat 'identity files " "))
  397.          (cond
  398.           (files
  399.            (cond
  400.         (gnus-uudecode-auto-chmod
  401.          (setq command (concat "cd " directory " ; chmod "
  402.                        gnus-uudecode-auto-chmod " " files-str))
  403.          (gnus-mark-shell-command (point) (point) command nil)
  404.          (setq all (concat all "\n" command "\n" (buffer-string)))))
  405.            (cond
  406.         (gnus-uudecode-auto-touch
  407.          (setq command (concat "cd " directory " ; touch " files-str))
  408.          (gnus-mark-shell-command (point) (point) command nil)
  409.          (setq all (concat all "\n" command "\n" (buffer-string)))))
  410.           (goto-char (point-min))
  411.           (insert all "\n")
  412. ;          (mapcar (function (lambda (x)
  413. ;            (dired-add-entry-all-buffers directory x)))
  414. ;              files)
  415.           ))))
  416.       (t
  417.        (message "wrote file %s" final-file)
  418.        (let ((case-fold-search t))
  419.          (cond ((null gnus-uudecode-picture-pattern) nil)
  420.            ((and (string-match gnus-uudecode-picture-pattern
  421.                        final-file)
  422.              (y-or-n-p
  423.                (format "look at the picture in %s? " final-file)))
  424.             (gnus-mark-shell-command (point) (point)
  425.               (if (string-match (regexp-quote directory) final-file)
  426.               (concat "cd " directory " ; "
  427.                                   gnus-uudecode-picture-viewer " "
  428.                   (substring final-file (match-end 0)))
  429.             (concat gnus-uudecode-picture-viewer " " final-file))
  430.               nil)
  431.             (if (y-or-n-p (format "delete file %s? " final-file))
  432.             (progn
  433.               (delete-file final-file)
  434.               (message "%s deleted." final-file))
  435.             )
  436.             (display-buffer "*Article*")))))
  437.       )))
  438.       ;; protected
  439.       (and tmp-buf (kill-buffer tmp-buf)))))
  440.  
  441.  
  442. ;;; shar (ack pffleughhh barf)
  443.  
  444. (defvar gnus-unshar-program "/bin/sh"
  445.   "*The program to use to unshar files; you might want to use something
  446. that is less of a gaping security hole than /bin/sh.")
  447.  
  448. (defvar gnus-unshar-default-directory nil "*")
  449.  
  450. (defun gnus-unshar-marked-articles (directory)
  451.   "For each of the marked articles, strip the junk from the beginning and end
  452. and then run the result through gnus-unshar-program (typically /bin/sh.)"
  453.   (interactive (list (gnus-mark-read-directory
  454.                "unshar in directory: " gnus-unshar-default-directory)))
  455.   (setq gnus-unshar-default-directory directory)
  456.   (let (tmp-buf
  457.     (command (concat "cd " directory " ; " gnus-unshar-program)))
  458.     (unwind-protect
  459.       (progn
  460.        (if (setq tmp-buf (get-buffer "*Shell Command Output*"))
  461.        (save-excursion
  462.          (set-buffer tmp-buf)
  463.          (erase-buffer)))
  464.        (setq tmp-buf (get-buffer-create "*gnus-unshar-tmp*"))
  465.        (gnus-summary-mark-map-articles
  466.     gnus-default-mark-char
  467.     (function (lambda (msg)
  468.       (message "Snarfing article %s..." (aref msg 0))
  469.       (if (eq gnus-current-article (aref msg 0))
  470.           (gnus-summary-mark-as-read)
  471.         (gnus-summary-display-article (aref msg 0)))
  472.       (set-buffer gnus-article-buffer)
  473.       (widen)
  474.       (set-buffer tmp-buf)
  475.       (erase-buffer)
  476.       (insert-buffer gnus-article-buffer)
  477.       (or (re-search-forward "^#!" nil t)
  478.           (re-search-forward "^: This is a shar archive" nil t)
  479.           (re-search-forward "^# This is a shell archive" nil t)
  480.           (re-search-forward "^# type \"sh file -c\"." nil t)
  481.           (re-search-forward "^#!" nil nil)) ; for the error message
  482.       (beginning-of-line)
  483.       (delete-region (point-min) (point))
  484.       (goto-char (point-max))
  485.       ;; what kind of shithead has a signature after a shar file?
  486.       (if (re-search-backward "^--" nil t)
  487.           (delete-region (point) (point-max)))
  488.       (message "unsharing article %s..." (aref msg 0))
  489.       (gnus-mark-shell-command (point-min) (point-max) command nil)
  490.       (message "unsharing article %s...done." (aref msg 0))
  491.       ))))
  492.       ;; protected
  493.       (kill-buffer tmp-buf)
  494. ;      (if (y-or-n-p "Display *Article* buffer? ")
  495. ;      (display-buffer "*Article*"))
  496.       )))
  497.  
  498.  
  499. ;;; This code encapsulates the definitions of the standard gnus-save-in-*
  500. ;;; functions to operate on the marked articles.
  501.  
  502. (defvar gnus-save-marked-in-same-file t
  503.   "*When saving multiple marked articles, whether to prompt each time.
  504. If t, you will be asked where to save them once, and all messages will
  505. be saved there.  If nil, you will be prompted for each article.")
  506.  
  507. (defvar inside-gnus-save-marked-articles-mapper)
  508. (defun gnus-save-marked-articles-mapper (saver filename var)
  509.   (let* ((count 0)
  510.      (fn (function (lambda (msg)
  511.             (if filename
  512.                 (funcall saver filename)
  513.               (call-interactively saver)
  514.               (if gnus-save-marked-in-same-file
  515.                   (setq filename (symbol-value var))))
  516.             (setq count (1+ count))))))
  517.     (if (and (boundp 'inside-gnus-save-marked-articles-mapper)
  518.          inside-gnus-save-marked-articles-mapper)
  519.     (funcall fn nil)
  520.       (let ((inside-gnus-save-marked-articles-mapper t))
  521.       (gnus-summary-mark-map-articles gnus-default-mark-char fn)
  522.       (if (> count 0)
  523.           (message "%s"
  524.                (concat (format "Saved %d article%s"
  525.                        count (if (= count 1) "" "s"))
  526.                    (if gnus-save-marked-in-same-file
  527.                    (format " to %s" filename)))))))))
  528.  
  529.  
  530. (defvar gm-orig-gnus-summary-save-in-rmail
  531.   (symbol-function 'gnus-summary-save-in-rmail))
  532.  
  533. (defun gnus-summary-save-in-rmail (&optional filename)
  534.   "Append the marked articles to an Rmail file.
  535. Optional argument FILENAME specifies file name.
  536. Directory to save to is default to `gnus-article-save-directory' which
  537. is initialized from the SAVEDIR environment variable."
  538.   (interactive)
  539.   (gnus-save-marked-articles-mapper gm-orig-gnus-summary-save-in-rmail
  540.                     filename 'gnus-newsgroup-last-rmail))
  541.  
  542. (defvar gm-orig-gnus-summary-save-in-mail
  543.   (symbol-function 'gnus-summary-save-in-mail))
  544.  
  545. (defun gnus-summary-save-in-mail (&optional filename)
  546.   "Append the marked articles to a Unix mail file.
  547. Optional argument FILENAME specifies file name.
  548. Directory to save to is default to `gnus-article-save-directory' which
  549. is initialized from the SAVEDIR environment variable."
  550.   (interactive)
  551.   (gnus-save-marked-articles-mapper gm-orig-gnus-summary-save-in-mail
  552.                     filename 'gnus-newsgroup-last-mail))
  553.  
  554. (defvar gm-orig-gnus-summary-save-in-file
  555.   (symbol-function 'gnus-summary-save-in-file))
  556.  
  557. (defun gnus-summary-save-in-file (&optional filename)
  558.   "Append the marked articles to a file.
  559. Optional argument FILENAME specifies file name.
  560. Directory to save to is default to `gnus-article-save-directory' which
  561. is initialized from the SAVEDIR environment variable."
  562.   (interactive)
  563.   (gnus-save-marked-articles-mapper gm-orig-gnus-summary-save-in-file
  564.                     filename 'gnus-newsgroup-last-file))
  565.  
  566. (defvar gm-orig-gnus-summary-save-in-folder
  567.   (symbol-function 'gnus-summary-save-in-folder))
  568.  
  569. (defun gnus-summary-save-in-folder (&optional folder)
  570.   "Save the marked articles to a MH folder (using `rcvstore' in MH library).
  571. Optional argument FOLDER specifies folder name."
  572.   (interactive)
  573.   (gnus-save-marked-articles-mapper gm-orig-gnus-summary-save-in-folder
  574.                     folder 'gnus-newsgroup-last-folder))
  575.  
  576. (provide 'gnus-mark)
  577.